home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / pc_pad.arc / WORDPUZL.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1983-07-17  |  2.8 KB  |  50 lines
  1. 10  'WORD PUZZLE GENERATOR
  2. 20  'FROM SOFTSIDE MAGZINE, FEBRUARY 1983
  3. 30  DEF FNU$(A$)=CHR$(ASC(A$+" ")+32*(A$>="a" AND A$<="z"))
  4. 100  KEY OFF:WIDTH 40:CLS:LOCATE 10,9,0:PRINT "WORD SEARCH PUZZLE GENERATOR":LOCATE 12,14,0:PRINT "BY DAVID W. DURKEE":LOCATE 14,14,0:PRINT "COPYRIGHT (C) 1981":LOCATE 20,11:PRINT "PC VERSION BY FRED CONDO"
  5. 110  FOR I=1 TO 2500:NEXT I:LOCATE ,,1:OPEN "SCRN:" FOR OUTPUT AS #1:OPEN "LPT1:"FOR OUTPUT AS #2:CPF=1
  6. 120  CLS:LOCATE 10:PRINT #CPF,"TO CREATE A PUZZLE, SIMPLY ENTER A WORD YOU WOULD LIKE TO HAVE IN THE PUZZLE AFTER THE `?' PROMPT."
  7. 130  LOCATE 14:PRINT #CPF,"WHEN YOU'VE ENTERED ALL THE WORDS YOU WOULD LIKE IN THE PUZZLE, TYPE `STOP' AND THE PC WILL DO THE REST."
  8. 140  LOCATE 18:PRINT #CPF,"IF YOU WOULD LIKE TO MAKE A PUZZLE FOR YOURSELF (BLANK SCREEN), THEN TYPE `1'; OTHERWISE TYPE `0' TO BEGIN.";
  9. 150  INPUT BLANK:IF BLANK=1 THEN BLANK=-1 ELSE IF BLANK<>0 THEN 140
  10. 155  CLS:Z=0
  11. 160  DIM W$(200),B%(3,3),A%(40,20)
  12. 170  Z=Z+1
  13. 180  LOCATE 22,1:PRINT #CPF,SPACE$(40);:LOCATE 22,1:PRINT #CPF, "WORD #";STR$(Z);:LINE INPUT"? ";A$:IF A$="" THEN 180
  14. 190  TMP$="":FOR CHAR=1 TO LEN(A$):TMP$=TMP$+FNU$(MID$(A$,CHAR,1)):NEXT CHAR:IF TMP$="STOP" THEN 530
  15. 200  W$(Z)=A$
  16. 210  U=INT(RND(1)*20)+1:L=INT(RND(1)*40)+1:FOR X=-1 TO 1:FOR Y=-1 TO 1:IF X=Y AND Y=0 THEN 330
  17. 240  X1=L:Y1=U:FOR C=1 TO LEN(A$):X1=X1+X:Y1=Y1+Y:IF X1>40 OR X1<1 OR Y1>20 OR Y1<1 THEN B%(X+2,Y+2)=0:GOTO 330
  18. 280  IF A%(X1,Y1)=0 THEN 310
  19. 290  IF A%(X1,Y1)<>ASC(MID$(A$,C,1)) THEN B%(X+2,Y+2)=0:GOTO 330
  20. 300  B%(X+2,Y+2)=B%(X+2,Y+2)+1
  21. 310  NEXT C
  22. 320  B%(X+2,Y+2)=B%(X+2,Y+2)+1:B=B+1
  23. 330  NEXT Y:NEXT X:IF B=0 THEN 210
  24. 350  R=2:D=2:FOR X=1 TO 3:FOR Y=1 TO 3:IF B%(X,Y)>B%(R,D) THEN R=X:D=Y
  25. 380  NEXT Y:NEXT X:X=R-2:Y=D-2:IF X=-1 AND Y=-1 AND B%(1,1)=1 THEN 420
  26. 410  GOTO 440
  27. 420  X=INT(RND(1)*3)-1:Y=INT(RND(1)*3)-1
  28. 430  IF(X=0 AND Y=0) OR B%(X+2,Y+2)=0 THEN 420
  29. 440  X1=L:Y1=U:FOR C=1 TO LEN(A$):X1=X1+X:Y1=Y1+Y:A%(X1,Y1)=ASC(MID$(A$,C,1)):IF BLANK THEN 550
  30. 490  LOCATE Y1,X1:PRINT #CPF,CHR$(A%(X1,Y1));
  31. 500  NEXT C
  32. 510  B=0:FOR X=1 TO 3:FOR Y=1 TO 3:B%(X,Y)=O:NEXT Y:NEXT X:LOCATE 22,1:PRINT #CPF,SPC(39);:GOTO 170
  33. 530  FOR X=1 TO 40:FOR Y=1 TO 20:IF A%(X,Y)<>0 THEN 560
  34. 550  A%(X,Y)=45:LOCATE Y,X:PRINT #CPF,"-";
  35. 560  NEXT Y:NEXT X
  36. 570  LOCATE 22:LINE INPUT"READY TO PRINT. TURN PRINTER ON AND HIT <RETURN>...";A$:CPF=2:GOSUB 680
  37. 580  PRINT #CPF,:PRINT #CPF,"WORD PUZZLE ANSWER KEY";:PRINT #CPF,CHR$(12);:CPF=1:PRINT #CPF,:PRINT #CPF,"PLEAS WAIT A MINUTE FOR ME TO CREATE THE PUZZLE...":CPF=2:FOR X=1 TO 40:FOR Y=1 TO 20:IF A%(X,Y)<>45 THEN 640
  38. 630  B=INT(RND(1)*26)+65:IF RND (1)<0.5 THEN A%(X,Y)=B ELSE A%(X,Y)=B+32
  39. 640  NEXT Y:NEXT X
  40. 650  GOSUB 680:PRINT #CPF,:PRINT #CPF,"COMPUTER GENERATED WORD PUZZLE"
  41. 670  PRINT #CPF,CHR$(12);:GOTO 730
  42. 680  PRINT #CPF,:FOR X=1 TO 40:FOR Y=1 TO 20:PRINT #CPF,CHR$(A%(X,Y));" ";:NEXT Y:PRINT #CPF,:NEXT X
  43. 720  RETURN
  44. 730  PRINT #CPF,"WORD LIST":PRINT #CPF,:FOR Z7=1 TO Z-2:PTR=27:FOR Z8=Z7+1 TO Z-1:IF W$(Z8)<W$(PTR) THEN PTR=Z8
  45. 750  NEXT Z8:SWAP W$(Z7),W$(PTR):NEXT Z7
  46. 760  FOR I=1 TO Z-1:PRINT #CPF,W$(I):NEXT I
  47. 770  CPF=1:PRINT #CPF,:LINE INPUT"WOULD YOU LIKE ANOTHER COPY? ";A$:IF FNU$(A$)="Y" THEN CPF=2:PRINT #CPF,CHR$(12):GOTO 650
  48. 790  CLOSE:WIDTH 80:KEY ON:END
  49. 65399  '** DONE - PRESS ENTER TO RETURN TO MENU **
  50.